temskwk.pas

Do your applications look a little boring? Would you like to get spectacular yet easy to use visual

      2:   Apply1bppMask_2(
             PChar(Work ) - UpdParBmp.Start1,
             PChar(Dst  ) - UpdParBmp.Start1,
             PChar(Mask ) - UpdParMsk.Start1,
             -UpdParMsk.Lenght1,
             UpdParMsk.RowLenght1,
             UpdParMsk.Gap1);
      3: begin
           Apply1bppMask_2(
             PChar(Work ) - UpdParBmp.Start1,
             PChar(Dst  ) - UpdParBmp.Start1,
             PChar(Mask ) - UpdParMsk.Start1,
             -UpdParMsk.Lenght1,
             UpdParMsk.RowLenght1,
             UpdParMsk.Gap1);
           Apply1bppMask_2(
             PChar(Work ) - UpdParBmp.Start2,
             PChar(Dst  ) - UpdParBmp.Start2,
             PChar(Mask ) - UpdParMsk.Start2,
             -UpdParMsk.Lenght2,
             UpdParMsk.RowLenght2,
             UpdParMsk.Gap2);
           Apply1bppMask_2(
             PChar(Work ) - UpdParBmp.Start3,
             PChar(Dst  ) - UpdParBmp.Start3,
             PChar(Mask ) - UpdParMsk.Start3,
             -UpdParMsk.Lenght3,
             UpdParMsk.RowLenght3,
             UpdParMsk.Gap3);
           Apply1bppMask_2(
             PChar(Work ) - UpdParBmp.Start4,
             PChar(Dst  ) - UpdParBmp.Start4,
             PChar(Mask ) - UpdParMsk.Start4,
             -UpdParMsk.Lenght4,
             UpdParMsk.RowLenght4,
             UpdParMsk.Gap4);
        end;
    end;
  end;
end;

procedure MaskOptimization(Mask1, Mask2: PDWordArray; k: Longint);
var
  aux: DWord;
begin
  while k < 0 do
  begin
    aux      := not Mask2[k];
    Mask2[k] := Mask2[k] and Mask1[k];
    Mask1[k] := Mask1[k] or aux;
    Inc(k);
  end;
end;

procedure MaskOptimizationRect(Mask1, Mask2: PDWordArray; k, UpdateRowLenght,
  UpdateGap: Longint);
var
  Limit: Longint;
  aux: DWord;
begin
  while k < 0 do
  begin
    Limit := k + UpdateRowLenght;
    while k < Limit do
    begin
      aux      := not Mask2[k];
      Mask2[k] := Mask2[k] and Mask1[k];
      Mask1[k] := Mask1[k] or aux;
      Inc(k);
    end;
    Inc(k, UpdateGap);
  end;
end;

procedure DoMaskOptimization(Mask1, Mask2: TBitmap; ScanLineSize: Integer;
  UpdateRect, UnUpdateRect: TRect);
var
  P1,
  P2: PDWordArray;
  UpdParams: TTEUpdParams;
  Mode: Byte;
begin
  Mode := GiveMeTheUpdMode(Mask1.Width, 0, 32, UpdateRect, UnUpdateRect, pf1bit);
  GiveMeTheUpdParams(Mode, UpdParams, ScanLineSize, UpdateRect, UnUpdateRect,
    pf1bit);

  P1 := PDWordArray(PChar(Mask1.ScanLine[0]) + ScanLineSize);
  P2 := PDWordArray(PChar(Mask2.ScanLine[0]) + ScanLineSize);

  case Mode of
    1: MaskOptimization(
         PDWordArray(PChar(P1) - UpdParams.Start1),
         PDWordArray(PChar(P2) - UpdParams.Start1),
         -UpdParams.Lenght1 div 32);
    2: MaskOptimizationRect(
         PDWordArray(PChar(P1) - UpdParams.Start1),
         PDWordArray(PChar(P2) - UpdParams.Start1),
         -UpdParams.Lenght1 div 32,
         UpdParams.RowLenght1 div 32,
         UpdParams.Gap1 div 32);
    3: begin
         MaskOptimizationRect(
           PDWordArray(PChar(P1) - UpdParams.Start1),
           PDWordArray(PChar(P2) - UpdParams.Start1),
           -UpdParams.Lenght1 div 32,
           UpdParams.RowLenght1 div 32,
           UpdParams.Gap1 div 32);
         MaskOptimizationRect(
           PDWordArray(PChar(P1) - UpdParams.Start2),
           PDWordArray(PChar(P2) - UpdParams.Start2),
           -UpdParams.Lenght2 div 32,
           UpdParams.RowLenght2 div 32,
           UpdParams.Gap2 div 32);
         MaskOptimizationRect(
           PDWordArray(PChar(P1) - UpdParams.Start3),
           PDWordArray(PChar(P2) - UpdParams.Start3),
           -UpdParams.Lenght3 div 32,
           UpdParams.RowLenght3 div 32,
           UpdParams.Gap3 div 32);
         MaskOptimizationRect(
           PDWordArray(PChar(P1) - UpdParams.Start4),
           PDWordArray(PChar(P2) - UpdParams.Start4),
           -UpdParams.Lenght4 div 32,
           UpdParams.RowLenght4 div 32,
           UpdParams.Gap4 div 32);
       end;
  end;
end;

procedure InvertMask(Mask: PDWordArray; k: Longint);
begin
  while k < 0 do
  begin
    Mask[k] := not Mask[k];
    Inc(k);
  end;
end;

// 8 bit mask routines

function GetApply256MaskSProc: PByteArray;
{$ifdef TrialLimited}begin Result := nil; end;{$else}
const
  Body1: array[1..45] of Byte = (
    $55,                     
    $89,$E5,                 
    $57,                     
    $56,                     
    $53,                     
    $83,$7D,$10,$00,         
    $0F,$84,$9B,$01,$00,$00, 
    $BF,$01,$01,$01,$01,     
    $0F,$6E,$F7,             
    $89,$D7,                 
    $89,$CE,                 
    $8B,$5D,$14,             
    $8B,$4D,$10,             
    $89,$C2,                 
    $0F,$EF,$C0,             
    $0F,$60,$F0,             
    $8B,$45,$0C);            

  Prefetch: array[1..24] of Byte = (
    $0F,$18,$84,$8E,$20,$00,$00,$00, 
    $0F,$18,$84,$8F,$20,$00,$00,$00, 
    $0F,$18,$84,$19,$20,$00,$00,$00);

  Body2: array[1..346] of Byte = (
    $0F,$6F,$54,$8E,$18,     
    $0F,$6F,$5C,$8F,$18,     
    $0F,$6F,$E2,             
    $0F,$60,$D0,             
    $0F,$6F,$EB,             
    $0F,$60,$D8,             
    $0F,$F9,$D3,             
    $0F,$6F,$0C,$0B,         
    $0F,$68,$C8,             
    $0F,$FD,$CE,             
    $0F,$6F,$F9,             
    $0F,$65,$FE,             
    $0F,$DB,$CF,             
    $0F,$6F,$F9,             
    $0F,$69,$C9,             
    $0F,$6F,$D9,             
    $0F,$61,$C9,             
    $0F,$D5,$D1,             
    $0F,$69,$DB,             
    $0F,$68,$E0,             
    $0F,$68,$E8,             
    $0F,$F9,$E5,             
    $0F,$D5,$E3,             
    $0F,$71,$D2,$08,         
    $0F,$71,$D4,$08,         
    $0F,$67,$D4,             
    $0F,$FC,$54,$8F,$18,     
    $0F,$E7,$54,$8A,$18,     
    $0F,$6F,$54,$8E,$10,     
    $0F,$6F,$5C,$8F,$10,     
    $0F,$6F,$E2,             
    $0F,$60,$D0,             
    $0F,$6F,$EB,             
    $0F,$60,$D8,             
    $0F,$F9,$D3,             
    $0F,$61,$FF,             
    $0F,$6F,$DF,             
    $0F,$61,$FF,             
    $0F,$D5,$D7,             
    $0F,$69,$DB,             
    $0F,$68,$E0,             
    $0F,$68,$E8,             
    $0F,$F9,$E5,             
    $0F,$D5,$E3,             
    $0F,$71,$D2,$08,         
    $0F,$71,$D4,$08,         
    $0F,$67,$D4,             
    $0F,$FC,$54,$8F,$10,     
    $0F,$E7,$54,$8A,$10,     
    $0F,$6F,$54,$8E,$08,     
    $0F,$6F,$5C,$8F,$08,     
    $0F,$6F,$E2,             
    $0F,$60,$D0,             
    $0F,$6F,$EB,             
    $0F,$60,$D8,             
    $0F,$F9,$D3,             
    $0F,$6F,$0C,$0B,         
    $0F,$60,$C8,             
    $0F,$FD,$CE,             
    $0F,$6F,$F9,             
    $0F,$65,$FE,             
    $0F,$DB,$CF,             
    $0F,$6F,$F9,             
    $0F,$69,$C9,             
    $0F,$6F,$D9,             
    $0F,$61,$C9,             
    $0F,$D5,$D1,             
    $0F,$69,$DB,             
    $0F,$68,$E0,             
    $0F,$68,$E8,             
    $0F,$F9,$E5,             
    $0F,$D5,$E3,             
    $0F,$71,$D2,$08,         
    $0F,$71,$D4,$08,         
    $0F,$67,$D4,             
    $0F,$FC,$54,$8F,$08,     
    $0F,$E7,$54,$8A,$08,     
    $0F,$6F,$14,$8E,         
    $0F,$6F,$1C,$8F,         
    $0F,$6F,$E2,             
    $0F,$60,$D0,             
    $0F,$6F,$EB,             
    $0F,$60,$D8,             
    $0F,$F9,$D3,             
    $0F,$61,$FF,             
    $0F,$6F,$DF,             
    $0F,$61,$FF,             
    $0F,$D5,$D7,             
    $0F,$69,$DB,             
    $0F,$68,$E0,             
    $0F,$68,$E8,             
    $0F,$F9,$E5,             
    $0F,$D5,$E3,             
    $0F,$71,$D2,$08,         
    $0F,$71,$D4,$08,         
    $0F,$67,$D4,             
    $0F,$FC,$14,$8F,         
    $0F,$E7,$14,$8A,         
    $83,$C1,$08,             
    $74,$15,                 
    $83,$E8,$08,             
    $0F,$85,$8E,$FE,$FF,$FF);

  Sfence: array[1..3] of Byte = (
    $0F,$AE,$FF);             

  Body3: array[1..20] of Byte = (
    $03,$4D,$08,             
    $0F,$85,$7F,$FE,$FF,$FF, 
    $0F,$77,                 
    $5B,                     
    $5E,                     
    $5F,                     
    $5D,                     
    $C2,$10,$00,             
    $8B,$C0);                
var
  SizeBody1,
  SizePrefetch,
  SizeBody2,
  SizeSfence,
  SizeBody3: Integer;
begin
  SizeBody1    := SizeOf(Body1);
  SizePrefetch := SizeOf(Prefetch);
  SizeBody2    := SizeOf(Body2);
  SizeSfence   := SizeOf(Sfence);
  SizeBody3    := SizeOf(Body3);

  GetMem(Result, SizeBody1 + SizePrefetch + SizeBody2 + SizeSfence + SizeBody3);
  CopyMemory(@(Result[0]), @Body1, SizeBody1);

  if TEProcessorInfo.SSE
  then
  begin
    CopyMemory(@(Result[SizeBody1]), @Prefetch, SizePrefetch);
    CopyMemory(@(Result[SizeBody1 + SizePrefetch]), @Body2, SizeBody2);
    CopyMemory(@(Result[SizeBody1 + SizePrefetch + SizeBody2]), @Sfence,
      SizeSfence);
    CopyMemory(@(Result[SizeBody1 + SizePrefetch + SizeBody2 + SizeSfence]),
      @Body3, SizeBody3);
  end
  else
  begin
    CopyMemory(@(Result[SizeBody1]), @Body2, SizeBody2);
    CopyMemory(@(Result[SizeBody1 + SizeBody2]), @Body3, SizeBody3);

    PByte(@Result[SizeBody1 +  91])^ := $7F;
    PByte(@Result[SizeBody1 + 164])^ := $7F;
    PByte(@Result[SizeBody1 + 259])^ := $7F;
    PByte(@Result[SizeBody1 + 329])^ := $7F;
    PInteger(@Result[12])^ := PInteger(@Result[12])^ - SizePrefetch - SizeSfence;
    PByte(@Result[SizeBody1 + 336])^ :=
      PByte(@Result[SizeBody1 + 336])^ - SizeSfence;
    PInteger(@Result[SizeBody1 + 342])^ :=
      PInteger(@Result[SizeBody1 + 342])^ + SizePrefetch;
    PInteger(@Result[SizeBody1 + SizeBody2 + 5])^ :=
      PInteger(@Result[SizeBody1 + SizeBody2 + 5])^ + SizePrefetch + SizeSfence;
  end;
end;
{$endif TrialLimited}

function GiveMeTheUpdMode(Width, MinGapPercentage, PixelGrain: Longint;
  var UpdateRect, UnUpdateRect: TRect; PixelFormat: TPixelFormat): Byte;
var
  UpdateWidth,
  UnUpdateWidth,
  Gap,
  MinGap: Longint;
begin
  UpdateRect  .Left  :=  (UpdateRect  .Left                    div PixelGrain) * PixelGrain;
  UpdateRect  .Right := ((UpdateRect  .Right + (PixelGrain-1)) div PixelGrain) * PixelGrain;
  UnUpdateRect.Left  := ((UnUpdateRect.Left  + (PixelGrain-1)) div PixelGrain) * PixelGrain;
  UnUpdateRect.Right :=  (UnUpdateRect.Right                   div PixelGrain) * PixelGrain;

  UpdateWidth   := UpdateRect  .Right - UpdateRect  .Left;
  UnUpdateWidth := UnUpdateRect.Right - UnUpdateRect.Left;
  if PixelFormat = pf1bit then
  begin
    UpdateWidth   := UpdateWidth   div 8;
    UnUpdateWidth := UnUpdateWidth div 8;
    Width := Width div 8;
  end;

  // Total gap
  MinGap := (Width * MinGapPercentage) div 100;
  Gap    := Width - UpdateWidth + UnUpdateWidth;

  if Gap <= MinGap
  then Result := 1 // Full scanline update
  else
  begin
    // UnUpdate gap
    MinGap := (UpdateWidth * MinGapPercentage) div 100;
    Gap    := UnUpdateWidth;
    if Gap <= MinGap
    then Result := 2 // Single rect update
    else Result := 3 // Four rects update
  end;
end;

procedure GiveMeTheUpdParams(Mode: Byte; var UpdParams: TTEUpdParams;
  ScanLineSize: Longint; UpdateRect, UnUpdateRect: TRect;
  PixelFormat: TPixelFormat);
const
  ByteCounts: array [pf1Bit..pf32Bit] of Single = (1/8, 1/2, 1, 2, 2, 3, 4);
var
  BytesPerPixel: Single;
begin
  BytesPerPixel := ByteCounts[PixelFormat];
  case Mode of
    1: with UpdParams do
         begin
           Start1     := UpdateRect.Top * ScanLineSize;
           Gap1       := 0;
           Lenght1    :=
             (UpdateRect.Bottom - UpdateRect.Top) *
             Round(ScanLineSize / BytesPerPixel);
           if Lenght1 < 0 then
             Lenght1 := 0;
           RowLenght1 := Lenght1;
         end;
    2: with UpdParams do
         begin
           Start1     :=
             (UpdateRect.Top * ScanLineSize) +
             (ScanLineSize - Round(UpdateRect.Right * BytesPerPixel));
           RowLenght1 := UpdateRect.Right - UpdateRect.Left;
           Gap1       := Round(ScanLineSize / BytesPerPixel) - RowLenght1;
           Lenght1    :=
             Round(((UpdateRect.Bottom * ScanLineSize) - Start1) / BytesPerPixel) -
             UpdateRect.Left;
           if(Lenght1 < 0) or (RowLenght1 <= 0) then
             Lenght1 := 0;
         end;
    3: with UpdParams do
         begin
           Start1     :=
             (UpdateRect.Top * ScanLineSize) +
             (ScanLineSize - Round(UpdateRect.Right * BytesPerPixel));
           RowLenght1 := UpdateRect.Right - UpdateRect.Left;
           Gap1       := Round(ScanLineSize / BytesPerPixel) - RowLenght1;
           Lenght1    :=
             Round(((UnUpdateRect.Top * ScanLineSize) - Start1) / BytesPerPixel) -
             UpdateRect.Left;

           Start2     := Start1 + Round((Lenght1 + Gap1) * BytesPerPixel);
           RowLenght2 := UpdateRect.Right - UnUpdateRect.Right;
           Gap2       := Round(ScanLineSize / BytesPerPixel) - RowLenght2;
           Lenght2    :=
             Round(((UnUpdateRect.Bottom * ScanLineSize) - Start2) / BytesPerPixel) -
             UnUpdateRect.Right;

           Start3     :=
             Start2 +
             Round((RowLenght2 + (UnUpdateRect.Right - UnUpdateRect.Left)) *
             BytesPerPixel);
           RowLenght3 := UnUpdateRect.Left - UpdateRect.Left;
           Gap3       := Round(ScanLineSize / BytesPerPixel) - RowLenght3;
           Lenght3    :=
             Round(((UnUpdateRect.Bottom * ScanLineSize) - Start3) / BytesPerPixel) -
             UpdateRect.Left;

           Start4     :=
             (UnUpdateRect.Bottom * ScanLineSize) +