⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 observerpalette.pas

📁 一个不出名的GBA模拟器
💻 PAS
📖 第 1 页 / 共 2 页
字号:
  X := X - details.Width;
  if (X > 7) and (X < totalDims+7) and (Y >= 16) and (Y < totalDims+16) then
    UpdateBGPaletteCoords(Sender, Shift, X-8, Y-16)
  else if (X > totalDims+15) and (X < totalDims*2+15) and (Y >= 16) and (Y < totalDims+16) then
    UpdateFGPaletteCoords(Sender, Shift, X-totalDims-16, Y-16)
  else begin
    lPaletteViewing.Caption := '(nothing selected)';
    lPaletteR.Caption := ' ';
    lPaletteG.Caption := ' ';
    lPaletteB.Caption := ' ';
    paletteCurrentColor := -1;
  end;
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevPalette.FormPaint(Sender: TObject);
begin
  UpdateObserver;
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevPalette.SetDims(patchSize: integer; hasGrid: boolean);
begin
  if patchSize = 1 then hasGrid := false;

  // Store the settings
  logDims := patchSize;
  if hasGrid then gridFactor := 1 else gridFactor := 0;
  totalDims := 16*(1 shl logDims);

  // Expand the viewer to accomodate the palette
  ClientWidth := 8 + totalDims + 8 + totalDims + 8 + details.Width;
  ClientHeight := 40 + totalDims + 8;
  lPaletteSprite.Left := 8 + totalDims + 8 + details.Width;
  lPaletteSprite.Width := totalDims;
  lPaletteBackground.Width := totalDims;

  // Reposition the buttons
  bLoadBG.Width := totalDims shr 1 - 1;
  bLoadBG.Left := 8 + details.Width;
  bLoadBG.Top := 22 + totalDims;

  bSaveBG.Width := totalDims shr 1 - 1;
  bSaveBG.Left := 8 + details.Width + totalDims shr 1 + 1;
  bSaveBG.Top := 22 + totalDims;

  bLoadFG.Width := totalDims shr 1 - 1;
  bLoadFG.Left := 16 + totalDims + details.Width;
  bLoadFG.Top := 22 + totalDims;

  bSaveFG.Width := totalDims shr 1 - 1;
  bSaveFG.Left := 16 + totalDims + details.Width + totalDims shr 1 + 1;
  bSaveFG.Top := 22 + totalDims;
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevPalette.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  w: uint32;
  r, g, b: byte;
  color: integer;
begin
  if paletteCurrentColor > -1 then begin
    w := vmReadHalfword($05000000 + paletteCurrentColor shl 1);
    w := (w and $1F) shl 3 + ((w shr 5) and $1F) shl 11 + ((w shr 10) and $1F) shl 19;
    colorDialog.Color := w;

    if colorDialog.execute then begin
      color := colorDialog.Color and $00FFFFFF;
      r := (color shr 3) and $1F;
      g := (color shr 11) and $1F;
      b := (color shr 19) and $1F;
      vmWriteHalfword($05000000 + paletteCurrentColor shl 1, b shl 10 + g shl 5 + r);
      UpdateObserver;
    end;
  end;
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevPalette.AlterDisplay(Sender: TObject);
begin
  decimalMode := cbDecimalMode.Checked;
  doubleSize := cbZoomed.Checked;
  showGrid := cbUseGrid.Checked;

  if doubleSize then SetDims(4, showGrid) else SetDims(3, showGrid);

  Invalidate;
  UpdateObserver;
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevPalette.LoadBGPalette(Sender: TObject);
var
  stream: TFileStream;
  banks: TvmMemoryLock1;
begin
  openDialog.Filter := 'Raw 512 byte palettes|*.pal|All files|*.*';
  openDialog.DefaultExt := 'pal';
  if openDialog.Execute then begin
    stream := TFileStream.Create(openDialog.FileName, fmOpenRead);
    if stream.Size = 512 then begin
      vmLockMemory(banks);
      stream.Read(banks.palette^, 512);
      vmUnlockMemory(banks);
    end else begin
      Beep;
      ShowMessage('Only 512 byte raw palettes in 5:5:5 format are currently supported');
    end;
    stream.Free;
  end;
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevPalette.SaveBGPalette(Sender: TObject);
var
  stream: TFileStream;
  banks: TvmMemoryLock1;
begin
  saveDialog.Filter := 'Raw 512 byte palette|*.pal|All files|*.*';
  saveDialog.DefaultExt := 'pal';
  if saveDialog.Execute then begin
    stream := TFileStream.Create(saveDialog.FileName, fmCreate);

    vmLockMemory(banks);
    stream.Write(banks.palette^, 512);
    vmUnlockMemory(banks);

    stream.Free;
  end;
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevPalette.LoadFGPalette(Sender: TObject);
var
  stream: TFileStream;
  banks: TvmMemoryLock1;
begin
  openDialog.Filter := 'Raw 512 byte palettes|*.pal|All files|*.*';
  openDialog.DefaultExt := 'pal';
  if openDialog.Execute then begin
    stream := TFileStream.Create(openDialog.FileName, fmOpenRead);
    if stream.Size = 512 then begin
      vmLockMemory(banks);
      stream.Read(pointer(integer(banks.palette) + 512)^, 512);
      vmUnlockMemory(banks);
    end else begin
      Beep;
      ShowMessage('Only 512 byte raw palettes in 5:5:5 format are currently supported');
    end;
    stream.Free;
  end;
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevPalette.SaveFGPalette(Sender: TObject);
var
  stream: TFileStream;
  banks: TvmMemoryLock1;
begin
  saveDialog.Filter := 'Raw 512 byte palette|*.pal|All files|*.*';
  saveDialog.DefaultExt := 'pal';
  if saveDialog.Execute then begin
    stream := TFileStream.Create(saveDialog.FileName, fmCreate);

    vmLockMemory(banks);
    stream.Write(pointer(integer(banks.palette) + 512)^, 512);
    vmUnlockMemory(banks);

    stream.Free;
  end;
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevPalette.LoadSettings(ini: TIniFile);
begin
  inherited;
  decimalMode := ini.ReadBool(OCaption, 'DecimalMode', false);
  doubleSize := ini.ReadBool(OCaption, 'DoubleSize', false);
  showGrid := ini.ReadBool(OCaption, 'ShowGrid', true);
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevPalette.SaveSettings(ini: TIniFile);
begin
  inherited;
  ini.WriteBool(OCaption, 'DecimalMode', decimalMode);
  ini.WriteBool(OCaption, 'DoubleSize', doubleSize);
  ini.WriteBool(OCaption, 'ShowGrid', showGrid);
end;

//////////////////////////////////////////////////////////////////////

procedure TjdevPalette.FormShow(Sender: TObject);
begin
  cbDecimalMode.Checked := decimalMode;
  cbZoomed.Checked := doubleSize;
  cbUseGrid.Checked := showGrid;

  // Load the translation
  LoadTranslation(self, translation);
end;

//////////////////////////////////////////////////////////////////////

initialization
  RegisterViewer(TjdevPalette);
end.

//////////////////////////////////////////////////////////////////////

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -