unit UPicShowEx;

interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, DB, DBCtrls, PSEffect, Picshow, ThUHelper, UExtGraphics,
  otlTask, otlTaskControl, otlComm, otlCommon,
  idTCPClient, UNetwork;

type
  TSlideChangeEvent = procedure (Sender:TObject; index:integer; aStyle:TShowStyle) of object;

  TPicShow = class(PicShow.TPicShow)
  private
    fImages:TStringlist;
    fSelectedIndex:integer;
    fDisplayedImageName:String;
    fOnSlideChange:TSlideChangeEvent;
    procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
    procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS;
  protected
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure doReadEachSlide(Task:IOmniTask; TCP:TIdTCPClient; index:Integer);
    procedure doReadSlideFromServer(Task:IOmniTask; Count:Integer; Host:String; Port:Word; OnReady:TProc);
    procedure ChangeSlideData(Index:Integer; Stream:TStream);
  public
    function ListFilesFromPath(aPath:String; backColor:TColor; ClearExisting:boolean;
      OnImg:TStrPtrProcRef):integer;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ShowImageByIndex(index:integer; aStyle:TShowStyle);
    function ShowNextImage(aStyle:TShowStyle):Boolean;
    function ShowPrevImage(aStyle:TShowStyle):Boolean;
    procedure PreparePreview(Source:TPicShow; aStyle:TShowStyle; StartIndex:integer=-1);
    function CopySlideImageToStream(Stream:TStream; Index:Integer):Boolean;
    function SlideCount:integer;
    function CurrentSlideIndex:integer;
    function HasSlides:Boolean;
    procedure ReadSlidesFromServer(Count:Integer; Host:String; Port:Word; OnReady:TProc);
    property DisplayedImageName:String read fDisplayedImageName;
    property OnSlideChange:TSlideChangeEvent read fOnSlideChange write fOnSlideChange;
  end;


implementation
uses JPEG, PNGImage;


function CreatePicture(FileName:String; backColor:TColor; Width:Integer=0; Height:Integer=0):TBitmap;
var
  P:TPicture;
  G:TGraphic;
begin
  result:=nil;
  P:=TPicture.Create;
  try
    try
      P.LoadFromFile(FileName);
      G:=P.Graphic;
      if assigned(G) then
        result:=GenerateBitmapFromGraphic(G,G.Width,G.Height,true,true,true,backColor);
    except
    end;
  finally
    P.Free;
  end;
end;

{TPicShow}
constructor TPicShow.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fImages:=TStringList.Create;
  fImages.OwnsObjects:=true;
  fSelectedIndex:=-1;
  //Self.ComponentStyle
  ControlStyle := ControlStyle - [csSetCaption] + [csCaptureMouse, csOpaque, csReplicatable, csDisplayDragImage,
    csReflector];
end;

destructor TPicShow.Destroy;
begin
  Destroying;
  fImages.Clear;
  FreeAndNil(fImages);
  inherited Destroy;
end;

function TPicShow.CopySlideImageToStream(Stream:TStream; Index:Integer):Boolean;
var
  G:TGraphic;
begin
  result:=false;
  if (index>=0) and (index<fimages.Count) then begin
    G:=fImages.Objects[Index] as TGraphic;
    G.SaveToStream(Stream);
  end;
end;

procedure TPicShow.ShowImageByIndex(index:integer; aStyle:TShowStyle);
begin
  if (index>=0) and (index<fimages.Count) then begin
    if Busy then Stop;
    fSelectedIndex:=Index;
    Picture.Graphic:=fImages.Objects[Index] as TGraphic;
    Style:=aStyle;
    fDisplayedImageName := fImages.Strings[Index];
    Execute;
    if Assigned(fOnSlideChange)
      then fOnSlideChange(Self,index,aStyle);
  end;
end;


function TPicShow.ShowNextImage(aStyle:TShowStyle):Boolean;
begin
  result:=(fImages.Count>0) and (fSelectedIndex<fImages.Count-1);
  if result then
    ShowImageByIndex(fSelectedIndex+1,aStyle);
end;

function TPicShow.ShowPrevImage(aStyle:TShowStyle):Boolean;
begin
  result:=(fImages.Count>0) and (fSelectedIndex>0);
  if result then
    ShowImageByIndex(fSelectedIndex-1,aStyle);
end;

function TPicShow.HasSlides:Boolean;
begin
  result:=fImages.Count>0;
end;

function TPicShow.SlideCount:integer;
begin
  result:=fImages.Count;
end;

function TPicShow.CurrentSlideIndex:integer;
begin
  result:=fSelectedIndex;
end;


procedure TPicShow.PreparePreview(Source:TPicShow; aStyle:TShowStyle; StartIndex:integer=-1);
var
  G,NewG:TGraphic;
  aClass:TGraphicClass;
  i: Integer;
begin
  fSelectedIndex:=-1;
  fImages.Clear;
  Picture.Graphic:=nil;
  for i := 0 to Source.fImages.Count-1 do begin
    G:=Source.fImages.Objects[i] as TGraphic;
    aClass:=TGraphicClass(G.ClassType);
    NewG:=aClass.Create;
    NewG.Assign(G);
    fImages.AddObject(Source.fImages.Strings[i],newg);
  end;
  if StartIndex>=0 then begin
    ShowImageByIndex(StartIndex,aStyle);
  end;
end;

function Cmp1(List: Classes.TStringList; Index1, Index2: Integer): Integer;
var
  s1,s2:String;
  n1,n2:int64;
begin
  s1:=ChangeFileExt(ExtractFileName(List.Strings[Index1]),'');
  s2:=ChangeFileExt(ExtractFileName(List.Strings[Index2]),'');
  s1:=StringReplace(s1,'Slide','',[rfReplaceAll,rfIgnoreCase]);
  s2:=StringReplace(s2,'Slide','',[rfReplaceAll,rfIgnoreCase]);
  if TryStrToInt64(s1,n1) and TryStrToInt64(s2,n2) then begin
    s1:=IntToHex(n1,8);
    s2:=IntToHex(n2,8);
  end;
  result:=CompareText(s1,s2);
end;

function TPicShow.ListFilesFromPath(aPath:String; backColor:TColor; ClearExisting:boolean;
  OnImg:TStrPtrProcRef):integer;
var
  i:integer;
  fn:String;
  G:TGraphic;
begin
  result:=0;
  fSelectedIndex:=-1;
  if ClearExisting then
    fImages.Clear;
  if ListFiles(aPath,GraphicFileMask(TGraphic),faAnyFile,fiMages)>0 then begin
    fImages.CustomSort(cmp1);
    for i := 0 to fImages.Count-1 { downto 0 }do begin
      fn:=fImages.Strings[i];
      G:=CreatePicture(fn,backColor,Width,Height);
      //if assigned(G) then begin
        fImages.Objects[i]:=G;
        if assigned(OnImg) then
          OnImg(fn,G);
      //end
      //else
        //  OutList.Delete(i);

     end;
  end;
  result:=fImages.count;
end;

procedure TPicShow.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key,Shift);
end;

procedure TPicShow.KeyUp(var Key: Word; Shift: TShiftState);
begin
  inherited KeyUp(Key,Shift);
end;

procedure TPicShow.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
  Message.Result := DLGC_WANTCHARS or DLGC_WANTARROWS;
  //if FWantTabs then
  //  Message.Result := Message.Result or DLGC_WANTTAB;
end;

procedure TPicShow.WMKeyDown(var Message: TWMKeyDown);
begin
  inherited;
end;

procedure TPicShow.WMSetFocus(var Msg: TWMSetFocus);
begin
  inherited;
end;

procedure TPicShow.ChangeSlideData(Index:Integer; Stream:TStream);
var
  obj:TObject;
  J:TBitmap;
begin

  try
    if (Index>=0) and (Index<fImages.Count) then begin
      obj:=fImages.Objects[Index];
      J:=TBitmap.Create;
      J.LoadFromStream(Stream);
      fImages.Objects[Index]:=J;
      if Assigned(obj) then
        obj.Free;
    end;
  finally

  end;
end;

procedure TPicShow.doReadEachSlide(Task:IOmniTask; TCP:TIdTCPClient; index:Integer);
var
  F:TStream;
  sz:int64;
  idx:integer;
begin
  F:=TMemoryStream.Create;
  try
    TCP.IOHandler.WriteMyPackedHeader(CMD_GETSLIDE,index,0,0);
    sz:=TCP.IOHandler.ReadInt64;
    if sz>0 then begin
      TCP.IOHandler.ReadStream(F,sz);
      F.Position:=0;
      idx:=F.ReadInt;
      TTHread.Synchronize(nil,
//      Task.Invoke(
        procedure
        begin
          ChangeSlideData(idx,F);
          if index<0 then
            fSelectedIndex:=idx;
        end);
    end;
  finally
    F.Free;
  end;
end;

procedure TPicShow.doReadSlideFromServer(Task:IOmniTask; Count:Integer; Host:String; Port:Word; OnReady:TProc);
var
  N:Integer;
  stopped:Boolean;
  TCP:TIdTCPClient;
  cnt:integer;
  sz:Int64;
begin
  N:=0;
  if not (Task.Stopped or task.Terminated or (count<1)) then begin
    TCP:=TIdTCPClient.Create(nil);
    try
      TCP.Host:=Host;
      TCP.Port:=Port;
      TCP.Connect;
      if TCP.Connected then begin
        stopped:=Task.Stopped or task.Terminated or (n>=count);
        doReadEachSlide(Task,TCP,-1);
        if Assigned(OnReady) then
          OnReady;
        while not stopped do begin
          doReadEachSlide(Task,TCP,n);
          inc(n);
          stopped:=Task.Stopped or task.Terminated or (n>=count);
        end;
      end;
    finally
      TCP.Free;
    end;
  end;
end;

procedure TPicShow.ReadSlidesFromServer(Count:Integer; Host:String; Port:Word; OnReady:TProc);
var
  fTask:IOmniTaskControl;
  i: Integer;
  B:TBitmap;
begin
  fImages.Clear;
  for i := 1 to count do begin
    B:=TBitmap.Create;
    fImages.AddObject('Slide '+inttostr(i),B);
  end;
  fTask:=CreateTask(
    procedure(const task: IOmniTask)
    begin
      doReadSlideFromServer(Task,Count,Host,Port,onReady);
    end, 'List Broadcast')
  .OnTerminated(
    procedure (const Task:IOmniTaskControl)
    begin
      fTask:=nil;
    end)
  .Run;
end;

end.